home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib06.dsk / TRAC PLUS.bas < prev    next >
BASIC Source File  |  2023-02-26  |  8KB  |  199 lines
  1. 2  REM  *********2.13.87*********
  2. 3  REM  ** APPLE T.R.A.C.      **
  3. 4  REM  ** MICRO-SPARC, INC.   **
  4. 5  REM  ** P.O. BOX 325        **
  5. 6  REM  ** LINCOLN MASS 01773  **
  6. 7  REM  ** COPYRIGHT (C) 1981  **
  7. 8  REM  *************************
  8. 9  GOTO 10000: REM  ** HEADER ROUTINE ** 
  9. 10  REM  ';' PRINTING
  10. 11  PRINT  SPC( PK -SY)V$;
  11. 12 SY = SY +(PK -SY) + LEN(V$)
  12. 13  RETURN 
  13. 15  REM  END OF LINE PRINTING
  14. 16  PRINT  SPC( PK -SY)V$
  15. 17 PK = 0:SY = 0
  16. 18  RETURN 
  17. 22 M = R: REM   ** SORT ROUTINE **
  18. 23 M =  INT(M/2): IF M = 0  THEN 95
  19. 24 J = 1:K = R -M
  20. 25 H = J
  21. 30 V = H +M
  22. 40  IF WK(H,SR) <WK(V,SR)  THEN 87
  23. 50  FOR F = 1 TO 5
  24. 55 TK = WK(H,F):WK(H,F) = WK(V,F):WK(V,F) = TK
  25. 70  NEXT 
  26. 72 T$ = W$(H,6):W$(H,6) = W$(V,6):W$(V,6) = T$
  27. 75 H = H -M
  28. 80  IF H <1  THEN 87
  29. 85  GOTO 30
  30. 87 J = J +1
  31. 89  IF J >K  THEN 23
  32. 91  GOTO 25
  33. 95  FLASH : PRINT "SORT COMPLETED": NORMAL 
  34. 97  RETURN 
  35. 100  REM  ** WRITE ACCOUNTS ON SCREEN **
  36. 105  HOME : HTAB 8: INVERSE : PRINT "* ADD ";F$;" RECORDS *": NORMAL 
  37. 110  FOR N = 1 TO 12: PRINT N$(N);
  38. 120  HTAB 20: PRINT N$(N +12)
  39. 130  NEXT N
  40. 135  PRINT 
  41. 140  IF FL = 1  THEN  INVERSE : PRINT "1=MC   2=VSA   3=AMEX   4=GAS   5=OTHER"
  42. 142  IF FL = 2  THEN  INVERSE : PRINT "ENTER CHECK# 999 FOR CASH ENTRY"
  43. 145  PRINT "TYPE ACCOUNT#, 'REDO', 'EDIT' OR 'END'": NORMAL 
  44. 150  PRINT 
  45. 160  POKE 34, PEEK(37): RETURN 
  46. 175  RETURN 
  47. 200  REM  ** INPUT DATA **
  48. 202  GOSUB 100
  49. 203 I = I +1: NORMAL 
  50. 204  VTAB 19: CALL  -868: PRINT "REC #";I
  51. 205  VTAB 20: CALL  -868: INVERSE : INPUT "ACCOUNT # ";W$(I,1)
  52. 207  GOSUB 270
  53. 210  IF W$(I,1) = "END"  THEN  NORMAL :I = I -1: RETURN 
  54. 215  IF W$(I,1) = "REDO"  THEN I = I -1:I = I +(I = 0): GOTO 204
  55. 217  IF W$(I,1) = "EDIT"  THEN IS = I: INPUT "RECORD # TO EDIT?";I:W$(IS,1) = "": GOTO 204
  56. 220 W =  VAL(W$(I,1)): IF W >24  OR W <1  THEN  GOSUB 280: GOTO 205
  57. 225  VTAB 21: CALL  -868: PRINT F$;: INPUT "";W$(I,2)
  58. 226  GOSUB 270
  59. 227 W =  VAL(W$(I,2)): IF FL = 1  AND (W <1  OR W >5)  THEN  GOSUB 280: GOTO 225
  60. 230  VTAB 21: HTAB 25: CALL  -868: INPUT "MONTH,DAY:";W$(I,3),W$(I,4)
  61. 231  GOSUB 270
  62. 232 WM =  VAL(W$(I,3)):WD =  VAL(W$(I,4)): IF WM >12  OR WD >31  THEN  GOSUB 280: GOTO 230
  63. 235  VTAB 22: CALL  -868: PRINT "PAID TO: ";: NORMAL : PRINT "--------------";: HTAB 10: INPUT "";W$(I,6): INVERSE 
  64. 236  GOSUB 270: IF W$(I,6) = ""  THEN W$(I,6) = " "
  65. 237  IF  LEN(W$(I,6)) >14  THEN  VTAB 23: PRINT "MAX 14 CHARS ALLOWED..PLEASE REENTER": GOTO 235
  66. 240  VTAB 22: HTAB 25: CALL  -868: INPUT "AMOUNT:";W$(I,5)
  67. 241  GOSUB 270: IF  LEN(W$(I,5)) = 0  THEN  PRINT "": GOTO 240
  68. 242  IF  ASC(W$(I,5)) <48  OR  ASC(W$(I,5)) >57  THEN  VTAB 23: PRINT "NOT A NUMBER..PLEASE REENTER": GOTO 240
  69. 250  HOME : PRINT "LAST ACCT#";W$(I,1);" CD#";W$(I,2);" DT ";W$(I,3);"/";W$(I,4);" AMT $";W$(I,5)
  70. 254  IF IS >0  THEN X = I: GOSUB 1050:I = IS:IS = 0: GOTO 204
  71. 255  GOTO 203
  72. 270  VTAB 23: CALL  -868: RETURN 
  73. 280  VTAB 23: PRINT "INVALID ENTRY.. PLEASE REENTER": RETURN 
  74. 800  REM  ** PRINT SUMMARY **
  75. 801 YY = T:T = YY *(XX < >0)
  76. 805  PRINT D$;"PR#1"
  77. 807  PRINT  CHR$(9);"100N"
  78. 810  PRINT  CHR$(27);"Q"
  79. 820  PRINT  TAB( 25)F$;" SUMMARY REPORT"
  80. 825  PRINT  TAB( 27)"TODAY'S DATE ";MT;"/";D;"/";Y
  81. 827  IF OM = 3  THEN  PRINT  TAB( 27)"SORTED ";A$
  82. 828 FF$ =  RIGHT$(F$,7)
  83. 830  PRINT :PK = 1:V$ = "SEQ": GOSUB 10:PK = 12:V$ = "** PAID TO **": GOSUB 10:PK = 28:V$ = "ACC": GOSUB 10:PK = 36:V$ = FF$: GOSUB 10:PK = 44:V$ = "MO": GOSUB 10:PK = 50:V$ = "DAY": GOSUB 10
  84. 832 PK = 56:V$ = "AMOUNT": GOSUB 15
  85. 835  FOR X = 1 TO 70: PRINT "=";: NEXT X: PRINT 
  86. 840  FOR X = 1 TO I
  87. 845 PK = 1:V$ =  STR$(X): GOSUB 10
  88. 850 PK = 9:V$ = W$(X,6): GOSUB 10
  89. 855 PK = (31 - LEN(W$(X,1))):V$ = W$(X,1): GOSUB 10
  90. 860 PK = (41 - LEN(W$(X,2))):V$ = W$(X,2): GOSUB 10
  91. 865 PK = (46 - LEN(W$(X,3))):V$ = W$(X,3): GOSUB 10
  92. 870 PK = (52 - LEN(W$(X,4))):V$ = W$(X,4): GOSUB 10
  93. 875 W =  VAL(W$(X,5))
  94. 876 T = T +W: IF FL = 1  THEN CC =  VAL(W$(X,2)):CC(CC) = CC(CC) +W: REM  ** GRAND TOTAL AND CR CD TOTALS"
  95. 877 T =  INT(T *100 +.5)/100:CC(CC) =  INT(CC(CC) *100 +.5)/100
  96. 880 P = W: GOSUB 980
  97. 885 V$ =  STR$(W):PK = (52 +B -C -1): GOSUB 15
  98. 890  NEXT X
  99. 892  FOR X = 1 TO 70: PRINT "-";: NEXT X: PRINT 
  100. 895 P = T: GOSUB 980
  101. 900 PK = 1:V$ = " *** TOTAL ***": GOSUB 10:PK = (52 +B -C -1):V$ =  STR$(T): GOSUB 15
  102. 905  IF FL < >1  THEN 990: REM  ** SKIP CR CD SUMMARY **
  103. 907  PRINT : PRINT 
  104. 910  FOR X = 1 TO 5:P = CC(X): GOSUB 980: PRINT CD$(X);:V$ =  STR$(CC(X)):PK = (15 +B -C -1): GOSUB 15: NEXT 
  105. 960  GOTO 990
  106. 980 B = 9:C = (P > = 10) +(P > = 100) +(P > = 1000) +(P > = 10000): RETURN 
  107. 990  PRINT  CHR$(9);"40N": REM  CTRL I 40N
  108. 995  PRINT D$;"PR#0"
  109. 998  IF SW = 1  THEN  RETURN 
  110. 999  TEXT : CLEAR :BU = 1: GOTO 10002: REM   ** RETURN TO MENU **
  111. 1000  REM  ** ADD TO CURRENT FILE **
  112. 1005  ONERR  GOTO 1950
  113. 1010  PRINT D$;"OPEN";F$;",L40"
  114. 1020  PRINT D$;"READ";F$;",R0"
  115. 1025  INPUT R
  116. 1035  PRINT D$;"CLOSE";F$
  117. 1040 I = R: GOSUB 200: REM  **INPUT**
  118. 1045  TEXT 
  119. 1050  PRINT D$;"OPEN";F$;",L40"
  120. 1052  IF IS >0  THEN 1080: REM  DIRECT EDIT
  121. 1060  PRINT D$;"WRITE";F$;",R0"
  122. 1065  PRINT I
  123. 1070  FOR X = R +1 TO I
  124. 1080  PRINT D$;"WRITE";F$;",R";X
  125. 1085  PRINT W$(X,1): PRINT W$(X,2): PRINT W$(X,3): PRINT W$(X,4): PRINT W$(X,5): PRINT W$(X,6)
  126. 1087  IF IS >0  THEN 1095
  127. 1090  NEXT X
  128. 1095  PRINT D$;"CLOSE";F$
  129. 1097  IF IS >0  THEN  RETURN 
  130. 1100  IF SW = 1  THEN  RETURN 
  131. 1105 BU = 1: GOTO 10500: REM  ** RETURN TO MAIN MENU
  132. 1950 ER =  PEEK(222): POKE 216,0: IF ER < >5  THEN 1998
  133. 1955  PRINT D$;"CLOSE";F$
  134. 1956  PRINT D$;"OPEN";F$
  135. 1957  PRINT D$;"WRITE";F$;",R0"
  136. 1958  PRINT 0
  137. 1959  PRINT D$;"CLOSE";F$
  138. 1960 R = 0: GOTO 1040
  139. 1998  PRINT "ERROR NUMBER "; PEEK(222): PRINT "LOCATED IN LINE #"; PEEK(218) + PEEK(219) *256
  140. 1999  END 
  141. 2000  REM  ** DELETE RECORDS **
  142. 2001 Z = 0
  143. 2005  HOME : VTAB 10: FLASH : PRINT "READING ";F$;" FILE": NORMAL 
  144. 2010  PRINT D$;"OPEN";F$;",L40"
  145. 2020  PRINT D$;"READ";F$;",R0"
  146. 2025  INPUT R
  147. 2027  IF R = 0  THEN  INVERSE : PRINT " NO RECORDS STORED IN ";F$: NORMAL :BZ = 1: GOTO 2050
  148. 2028  IF R >100  THEN  VTAB 22: PRINT "THE MAX NUMBER OF RECORDS (100) HAS     BEEN EXCEEDED.":R = 100
  149. 2029  VTAB 2: PRINT "CLEANING OLD VARIABLES.":QJ =  FRE(0): VTAB 2: PRINT "                        "
  150. 2030  VTAB 12: FOR X = 1 TO R
  151. 2035  PRINT D$;"READ";F$;",R";X
  152. 2040  INPUT W$(X,1),W$(X,2),W$(X,3),W$(X,4),W$(X,5),W$(X,6)
  153. 2042  VTAB 12: PRINT X
  154. 2045  NEXT X
  155. 2050  PRINT D$;"CLOSE";F$: VTAB 12: PRINT "   "
  156. 2053  VTAB 10: PRINT "ONE MOMENT, PLEASE ..."
  157. 2055  IF SW = 1  THEN  RETURN 
  158. 2056  ONERR  GOTO 2060
  159. 2057  PRINT D$;"OPEN POSTED ";F$;",L40"
  160. 2058  PRINT D$;"READ POSTED ";F$;",R0"
  161. 2059  INPUT R2: GOTO 2065
  162. 2060 ER =  PEEK(222): POKE 216,0: IF ER < >5  THEN 1998
  163. 2061  PRINT D$;"CLOSE POSTED ";F$
  164. 2062  PRINT D$;"OPEN POSTED ";F$;",L40"
  165. 2063  PRINT D$;"WRITE POSTED ";F$;",R0"
  166. 2064  PRINT 0:R2 = 0
  167. 2065  PRINT D$
  168. 2066  HOME : HTAB 8: PRINT "* POST ";F$;" RECORDS *"
  169. 2067  PRINT : PRINT "POSTING A RECORD WILL:": PRINT : PRINT "   - DELETE RECORD FROM ";F$;" FILE"
  170. 2068  PRINT "   - ADD AMOUNT TO Y-T-D BALANCES"
  171. 2069  PRINT "   - WRITE RECORD TO POSTED ";F$;" FILE": PRINT : PRINT 
  172. 2070  VTAB 15: PRINT "WHICH RECORD # DO YOU WANT TO POST?"
  173. 2071  VTAB 16: CALL  -868: INVERSE : INPUT "ENTER RECORD # OR TYPE 'END': ";DL$
  174. 2072  IF DL$ = "END"  THEN  NORMAL : GOTO 2085
  175. 2073 DL =  VAL(DL$):DL$ = "": IF DL >R  THEN  VTAB 18: PRINT "NO SUCH RECORD. HIGHEST RECORD IS ";R: GOTO 2070
  176. 2074  IF W$(DL,1) = " "  AND W$(DL,2) = " "  THEN  VTAB 18: PRINT "RECORD ALREADY POSTED": GOTO 2070
  177. 2075  VTAB 18: CALL  -868: PRINT "DELETED: ";W$(DL,6);"   $";W$(DL,5)
  178. 2076 R2 = R2 +1
  179. 2077  PRINT D$;"WRITE POSTED ";F$;",R";R2
  180. 2078  PRINT W$(DL,1): PRINT W$(DL,2): PRINT W$(DL,3): PRINT W$(DL,4): PRINT W$(DL,5): PRINT W$(DL,6)
  181. 2079  PRINT D$
  182. 2080 Z = Z +1: FOR X = 1 TO 5:W(Z,X) =  VAL(W$(DL,X)): NEXT X: REM  ** TRANSFER TO WORK AREA **
  183. 2081 W$(DL,1) = " ":W$(DL,2) = " ": REM  ** FLAG FOR LATER COMPRESSING **
  184. 2083  GOTO 2071
  185. 2085  REM  ** COMPRESS FILE **
  186. 2087 N = 0:S = 0
  187. 2088 S = S +1
  188. 2090 N = N +1
  189. 2094  IF N >R  THEN 2205
  190. 2095  IF W$(N,1) = " "  AND W$(N,2) = " "  THEN 2090
  191. 2200  FOR X = 1 TO 6:W$(S,X) = W$(N,X): NEXT X
  192. 2202  GOTO 2088
  193. 2205  REM  ** WRITE COMPRESSED FILE TO DISK **
  194. 2210 I = S -1:R = 0:SW = 1: GOSUB 1050:SW = 0
  195. 2220  REM  CLOSE POSTED RECORD FILE
  196. 2224  PRINT D$;"WRITE POSTED ";F$;",R0"
  197. 2226  PRINT R2
  198. 2228  PRINT D$;"CLOSE POS<CTRL-D><CTRL-Q><CTRL-O><CTRL-C>
  199. 0